JVERSION = 3.00 _poolmanager ocollection PixelsClass1custom _poolmanager*cclass Name of the class to be pooled. cclasslibrary Name of the class library that contains the class to be pooled. ocollection Collection of pooled objects lraiseevent .T. = Raise events when objects are requested or returned nobjectscreated Is incremented every time a new object is created. Can be used to assign a unique ID to each object. *get parm1, parm2, ... returns a reference to a pooled object *objectrequested oObject, parm1, ... This event fires when an object has been requested. Use it to initialize the object if necessary. *free oObject. Checks an object back into the pool making it available for the next requester. *objectreturned oObject. This event is triggered when an object has been returned to the pool and becomes available for new requests. Use it to cleanup the object.   $%pDU[     TC=,tu01,tu02,tu03,tu04,tu05,tu06,tu07,tu08,tu09,tu10,tu11,tu12,1tu13,tu14,tu15,tu16,tu17,tu18,tu19,tu20,tu21,tu22Ct=%(CCC CC5 TT%CtTCHloObject = NewObject( This.cClass, This.cClassLibrary, "" &lcParam ) <C O%C O $ ZTCC C!L%!%Ct#CObjectRequested >RaiseEvent( This, "ObjectRequested", m.loObject &lcParam )  B U"TU01TU02TU03TU04TU05TU06TU07TU08TU09TU10TU11TU12TU13TU14TU15TU16TU17TU18TU19TU20TU21TU22LCPARAMLOOBJECTTHIS OCOLLECTIONCOUNTCCLASS CCLASSLIBRARYTHISPOOLMANAGERNOBJECTSCREATEDITEMREMOVE LRAISEEVENTb_     UTOOBJECTTU01TU02TU03TU04TU05TU06TU07TU08TU09TU10TU11TU12TU13TU14TU15TU16TU17TU18TU19TU20TU21TU22C O%C O ;  C CL%"CObjectReturned  TUROOBJECTTHIS OCOLLECTIONADD LRAISEEVENT UTOOBJECT CC LC$CC C C a6CC LC%C CT %C CT TC CollectionNCO%CO   UTCCLASSTCCLASSLIBRARYTHISCCLASS CCLASSLIBRARY OCOLLECTIONget,objectrequestedGfree;objectreturnedInit31uuqAAqqAq1Aq1AE1AA22t2AbB!A3t3Ar!Aq!AAA2$, ;&G z B2 W4 ^)PROCEDURE get *======================================================================================== * Returns an object for exclusive use of the caller. If the object doesn't exist, a new * one is created. *======================================================================================== LParameter tu01, tu02, tu03, tu04, tu05, tu06, tu07, tu08, tu09, tu10, tu11, tu12, ; tu13, tu14, tu15, tu16, tu17, tu18, tu19, tu20, tu21, tu22 *-------------------------------------------------------------------------------------- * Parameter string *-------------------------------------------------------------------------------------- Local lcParam lcParam = Left( ; ",tu01,tu02,tu03,tu04,tu05,tu06,tu07,tu08,tu09,tu10,tu11,tu12,"+; "tu13,tu14,tu15,tu16,tu17,tu18,tu19,tu20,tu21,tu22", ; Pcount()*5 ; ) *-------------------------------------------------------------------------------------- * obtain an object or create a new one *-------------------------------------------------------------------------------------- Local loObject If This.oCollection.Count == 0 Assert Vartype(This.cClass) == "C" Assert not Empty(This.cClass) Assert Vartype(This.cClassLibrary) == "C" Private THISPOOLMANAGER THISPOOLMANAGER = This This.nObjectsCreated = This.nObjectsCreated + 1 If Pcount() == 0 loObject = NewObject( This.cClass, This.cClassLibrary ) Else loObject = NewObject( This.cClass, This.cClassLibrary, "" &lcParam ) EndIf Release THISPOOLMANAGER Assert Vartype(m.loObject) == "O" If not Vartype(m.loObject) == "O" Error 1736 EndIf Else loObject = This.oCollection.Item(1) This.oCollection.Remove(1) EndIf *-------------------------------------------------------------------------------------- * Raise the ObjectRequested event *-------------------------------------------------------------------------------------- Assert Vartype(This.lRaiseEvent) == "L" If This.lRaiseEvent If Pcount() == 0 RaiseEvent( This, "ObjectRequested", m.loObject ) Else RaiseEvent( This, "ObjectRequested", m.loObject &lcParam ) EndIf EndIf Return m.loObject ENDPROC PROCEDURE objectrequested *======================================================================================== * Event fires when an object has been requested *======================================================================================== LParameter toObject, tu01, tu02, tu03, tu04, tu05, tu06, tu07, tu08, tu09, tu10, ; tu11, tu12, tu13, tu14, tu15, tu16, tu17, tu18, tu19, tu20, tu21, tu22 ENDPROC PROCEDURE free *======================================================================================== * Returns an object back to the pool. Sets the reference to NULL if successful. *======================================================================================== LParameter roObject Assert Vartype(m.roObject) == "O" If not Vartype(m.roObject) == "O" Error 11 EndIf This.oCollection.Add(m.roObject) Assert Vartype(This.lRaiseEvent) == "L" If This.lRaiseEvent RaiseEvent( This, "ObjectReturned", m.roObject) EndIf roObject = NULL ENDPROC PROCEDURE objectreturned *======================================================================================== * Event fires when an object has been returned *======================================================================================== LParameter toObject ENDPROC PROCEDURE Init *======================================================================================== * When used with CREATEOBJECT(), you can pass the class and library of the pooled object * as parameters. *======================================================================================== LParameter tcClass, tcClassLibrary Assert InList(Vartype(m.tcClass),"L","C") Assert Iif( Vartype(m.tcClass)=="C", not Empty(m.tcClass), .T. ) Assert InList(Vartype(m.tcClassLibrary),"L","C") If Vartype(m.tcClass) == "C" This.cClass = m.tcClass EndIf If Vartype(m.tcClassLibrary) == "C" This.cClassLibrary = m.tcClassLibrary EndIf This.oCollection = CreateObject("Collection") Assert Vartype(This.oCollection) == "O" If not Vartype(This.oCollection) == "O" Error 1736 EndIf ENDPROC rcclass = cclasslibrary = ocollection = .NULL. lraiseevent = .T. nobjectscreated = 0 Name = "_poolmanager" custom